home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / compiler / Load_phr.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  1.9 KB  |  64 lines  |  [TEXT/R*ch]
  1. (* To load in-core a compiled bytecode phrase, and execute it *)
  2.  
  3. open List Obj Memory Fnlib Mixture Const Instruct Types;
  4. open Symtable Patch Tr_const Opcodes Buffcode Reloc Emitcode Rtvals;
  5.  
  6. fun do_code may_free code entrypoint len =
  7. (
  8.   if number_of_globals() >= Vector.length global_data then
  9.     realloc_global_data(number_of_globals())
  10.   else ();
  11.   app
  12.     (fn (n, sc) => setGlobalVal n (translStructuredConst sc))
  13.     (!literal_table);
  14.   literal_table := [];
  15.   let val res =
  16.     interprete code entrypoint len
  17.     handle x =>
  18.       (if may_free then static_free code else ();
  19.        (case x of
  20.             Interrupt => raise x
  21.           | Toplevel => raise x
  22.           | Impossible _ => raise x
  23.           | Out_of_memory => gc_full_major()
  24.           | _ =>
  25.               ());
  26.        msgIBlock 0;
  27.        errPrompt "Uncaught exception: "; msgEOL(); errPrompt "";
  28.        printVal (trivial_scheme type_exn) (repr x);
  29.        msgEOL();
  30.        msgEBlock();
  31.        raise Toplevel)
  32.   in
  33.     if may_free then static_free code else ();
  34.     res
  35.   end
  36. );
  37.  
  38. fun loadZamPhrase (phr : ZamPhrase) =
  39. (
  40.   reloc_reset();
  41.   init_out_code();
  42.   Labels.reset_label_table();
  43.   literal_table := [];
  44.   (* It is essential to emit the initialization code *)
  45.   (* before the function bodies, in order for all Pset_global *)
  46.   (* to appear before all the Pget_global. *)
  47.   let val entrypoint = !out_position
  48.       val () = emit (#kph_inits phr)
  49.       val () = out STOP
  50.       val () = emit (#kph_funcs phr)
  51.       val len = !out_position
  52.       (* This is not a true string! *)
  53.       val code = static_alloc len
  54.       prim_val blit_string_ : string -> int -> string -> int -> int -> unit
  55.                                                        = 5 "blit_string"
  56.       val out_buffer_ = !(magic (!out_buffer) : string ref)
  57.   in
  58.     blit_string_ out_buffer_ 0 code 0 len;
  59.     patch_object code 0 (get_reloc_info());
  60.     do_code (case (#kph_funcs phr) of [] => true | _ => false)
  61.             code entrypoint len
  62.   end
  63. );
  64.